home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1995 May / macformat-024.iso / Shareware City / Developers / TransSkel Pascal 2.5 / TransSkel / Dialog ƒ / DialogSkel.p < prev    next >
Encoding:
Text File  |  1994-12-05  |  7.0 KB  |  333 lines  |  [TEXT/PJMM]
  1. { This program requires  TransSkel.p, Runtime.lib and Interface.lib in the same    }
  2. { project.    Also requires you to set the resource file to Dialog.proj.rsrc in the run options }
  3. { Puts up 2 dialog boxes, whose items affect the other dialog            }
  4. { ported to LS Pascal by Owen Hartnett, Ωhm Software Co.                        }
  5. { 7 January 1987    }
  6. {30 December 1987 - changes for version 2.00 }
  7. { Warning: Compile Time variable supportdialogs in TransSkel.p must be set to true! }
  8.  
  9. {Ingemar dec 1994: Added filter parameter to SkelDialog (as nil).}
  10.  
  11. program DialogSkel;
  12.  
  13.     uses
  14. {$IFC UNDEFINED THINK_PASCAL}
  15.         Memtypes, Quickdraw, OSIntf, ToolIntf, PackIntf, 
  16. {$ENDC}
  17.         TransSkel;
  18.  
  19.  
  20.     const
  21.         mDlogRes = 1000;
  22.         aboutAlrtRes = 1001;    { About... alert resource number }
  23.  
  24.         showDlog1 = 1;            { File Menu item numbers            }
  25.         showDlog2 = 2;
  26.         quit = 4;
  27.  
  28.         undo = 1;                     { Edit menu item numbers }
  29.         cut = 3;
  30.         copy = 4;
  31.         paste = 5;
  32.         clear = 6;
  33.  
  34.         button1 = 1;                { dialog item numbers }
  35.         edit1 = 2;
  36.         static1 = 3;
  37.         radio1 = 4;
  38.         radio2 = 5;
  39.         radio3 = 6;
  40.         check1 = 7;
  41.         check2 = 8;
  42.         user1 = 9;
  43.  
  44.     type
  45.         EventPtr = ^EventRecord;
  46.  
  47.     var
  48.         mDlog1, mDlog2: DialogPtr;
  49.  
  50.         iconNum1, iconNum2: integer;
  51.  
  52.         dummy: Boolean;                                { may be used for memory management }
  53.  
  54.     procedure DrawIcon (dlog: DialogPtr; item: integer);
  55.         var
  56.             h, itemHandle: Handle;
  57.             itemType: integer;
  58.             itemRect: Rect;
  59.     begin
  60.         GetDItem(dlog, item, itemType, itemHandle, itemRect);
  61.         if dlog = mDlog1 then
  62.             h := GetIcon(iconNum1)
  63.         else
  64.             h := GetICon(iconNum2);
  65.         PlotIcon(itemRect, h);
  66.     end;
  67.  
  68.     function GetDctl (dlog: DialogPtr; item: integer): Boolean;
  69.  
  70.         var
  71.             itemHandle: Handle;
  72.             itemType: integer;
  73.             itemRect: Rect;
  74.  
  75.     begin
  76.         GetDItem(dlog, item, itemType, itemHandle, itemRect);
  77.         GetDCtl := Boolean(GetCtlValue(ControlHandle(itemhandle)));
  78.     end;
  79.  
  80.     procedure SetDCtl (dlog: DialogPtr; item: integer; value: Boolean);
  81.  
  82.         var
  83.             itemHandle: Handle;
  84.             itemType: integer;
  85.             itemRect: Rect;
  86.     begin
  87.         GetDItem(dlog, item, itemType, itemHandle, itemRect);
  88.         SetCtlValue(ControlHandle(itemHandle), integer(value));
  89.     end;
  90.  
  91.     procedure GetDtext (dlog: DialogPtr; item: integer; var str: Str255);
  92.  
  93.         var
  94.             itemHandle: Handle;
  95.             itemType: integer;
  96.             itemRect: Rect;
  97.  
  98.     begin
  99.         GetDItem(dlog, item, itemType, itemHandle, itemRect);
  100.         GetIText(itemHandle, str);
  101.     end;
  102.  
  103.     procedure SetDText (dlog: DialogPtr; item: integer; str: Str255);
  104.         var
  105.             itemHandle: Handle;
  106.             itemType: integer;
  107.             itemRect: Rect;
  108.     begin
  109.         GetDItem(dlog, item, itemType, itemHandle, itemRect);
  110.         SetIText(itemHandle, str);
  111.     end;
  112.  
  113.     procedure SetDProc (dlog: DialogPtr; item: integer; p: ProcPtr);
  114.         var
  115.             itemHandle: Handle;
  116.             itemType: integer;
  117.             itemRect: Rect;
  118.     begin
  119.         GetDItem(dlog, item, itemType, itemHandle, itemRect);
  120.         SetDITem(dlog, item, itemType, Handle(p), itemRect);
  121.     end;
  122.  
  123.     procedure SetDRadio (dlog: DialogPtr; item: integer);
  124.  
  125.         var
  126.             partner: DialogPtr;
  127.             itemHandle: Handle;
  128.             itemType: integer;
  129.             itemRect: Rect;
  130.     begin
  131.         partner := DialogPtr(GetWRefCon(dlog));
  132.         SetDCtl(dlog, radio1, item = radio1);
  133.         SetDCtl(dlog, radio2, item = radio2);
  134.         SetDCtl(dlog, radio3, item = radio3);
  135.         if partner = mDlog1 then
  136.             iconNum1 := item - radio1
  137.         else
  138.             iconNum2 := item - radio1;
  139.  
  140.         GetDItem(partner, user1, itemType, itemHandle, itemRect);
  141.         SetPort(partner);
  142.         InvalRect(itemRect);
  143.     end;
  144.  
  145.     procedure Event (item: integer; event: EventPtr);
  146.  
  147.         var
  148.             actor, partner: DialogPtr;
  149.             title: Str255;
  150.             value: Boolean;
  151.             mypeek: WindowPeek;
  152.             mychar: Boolean;
  153.  
  154.     begin
  155.         GetPort(actor);
  156.         partner := DialogPtr(GetWRefCon(actor));
  157.         case item of
  158.             button1: 
  159.                 begin
  160.                     GetDText(actor, edit1, title);
  161.                     SetWTitle(partner, title);
  162.                 end;
  163.             radio1: 
  164.                 SetDRadio(actor, radio1);
  165.             radio2: 
  166.                 SetDRadio(actor, radio2);
  167.             radio3: 
  168.                 SetDRadio(actor, radio3);
  169.             check1: 
  170.                 begin
  171.                     value := not (GetDCtl(actor, item));
  172.                     SetDCtl(actor, item, value);
  173.                     if value = false then
  174.                         HideWindow(partner)
  175.                     else
  176.                         ShowWindow(partner);
  177.                 end;
  178.             check2: 
  179.                 begin
  180.                     value := not (GetDCtl(actor, check2));
  181.                     SetDCtl(actor, check2, value);
  182.                     mypeek := WindowPeek(partner);
  183.                     if value then
  184.                         mychar := true
  185.                     else
  186.                         mychar := false;
  187.  
  188.                     mypeek^.goAwayFlag := mychar;
  189.                 end;
  190.             otherwise
  191.         end;
  192.     end;
  193.  
  194.     procedure Close;
  195.  
  196.         var
  197.             actor, partner: DialogPtr;
  198.  
  199.     begin
  200.         GetPort(actor);
  201.         partner := DialogPtr(GetWRefCon(actor));
  202.         HideWindow(actor);
  203.         SetDCtl(partner, check1, false);
  204.     end;
  205.  
  206.     procedure Clobber;
  207.  
  208.         var
  209.             theDialog: DialogPtr;
  210.  
  211.     begin
  212.         GetPort(theDialog);
  213.         DisposDialog(theDialog);
  214.     end;
  215.  
  216. {    File menu handler}
  217.  
  218.     procedure DoFileMenu (item: integer);
  219.  
  220.     begin
  221.         case item of
  222.             showDlog1: 
  223.                 begin
  224.                     SelectWindow(mDlog1);
  225.                     ShowWindow(mDlog1);
  226.                     SetDCtl(mDlog2, check1, true);
  227.                 end;
  228.             showDlog2: 
  229.                 begin
  230.                     SelectWindow(mDlog2);
  231.                     ShowWindow(mDlog2);
  232.                     SetDCtl(mDlog1, check1, true);
  233.                 end;
  234.             quit: 
  235.                 SkelWhoa;
  236.         end;
  237.     end;
  238.  
  239. {    Handle Edit menu items for text window}
  240.  
  241.     procedure DoEditMenu (item: integer);
  242.  
  243.         var
  244.             theDialog: DialogPtr;
  245.             mypeek: WindowPeek;
  246.             ignore: integer;
  247.  
  248.     begin
  249.         theDialog := DialogPtr(FrontWindow);
  250.         mypeek := WindowPeek(theDialog);
  251.         if mypeek^.windowKind = dialogKind then
  252.             case item of
  253.                 cut: 
  254.                     begin
  255.                         DlgCut(theDialog);
  256.                         ignore := ZeroScrap;
  257.                         ignore := TEToScrap;
  258.                     end;
  259.                 copy: 
  260.                     begin
  261.                         DlgCopy(theDialog);
  262.                         ignore := ZeroScrap;
  263.                         ignore := TEToScrap;
  264.                     end;
  265.                 paste: 
  266.                     begin
  267.                         ignore := TEFromScrap;
  268.                         DlgPaste(theDialog);
  269.                     end;
  270.                 clear: 
  271.                     DlgDelete(theDialog);
  272.             end;
  273.     end;
  274.  
  275. {    Handle selection of About… item from Apple menu}
  276.  
  277.     procedure DoAbout;
  278.  
  279.         var
  280.             ignore: integer;
  281.     begin
  282.         ignore := Alert(aboutAlrtRes, nil);
  283.     end;
  284.  
  285.     function DemoDialog (title: Str255; x, y: integer): DialogPtr;
  286.  
  287.         var
  288.             theDialog: DialogPtr;
  289.  
  290.     begin
  291.         theDialog := GetNewDialog(mDlogRes, nil, WindowPtr(-1));
  292.         MoveWindow(theDialog, x, y, false);
  293.         SetWTitle(theDialog, title);
  294.         dummy := SkelDialog(theDialog, @Event, @Close, @Clobber, nil);
  295.         DemoDialog := theDialog;
  296.     end;
  297.  
  298.     var
  299.         m: MenuHandle;
  300.  
  301. begin
  302.     iconNum1 := 0;
  303.     iconNum2 := 0;
  304.     SkelInit(6, nil);
  305.     SkelApple('About DialogSkel…', @DoAbout);
  306.     m := NewMenu(1000, 'File');
  307.     AppendMenu(m, 'Show Dialog 1;Show Dialog 2;(-;Quit/Q');
  308.     dummy := SkelMenu(m, @DoFileMenu, nil, false);
  309.  
  310.     m := NewMenu(1001, 'Edit');
  311.     AppendMenu(m, '(Undo/Z;(-;Cut/X;Copy/C;Paste/V;Clear');
  312.     dummy := SkelMenu(m, @DoEditMenu, nil, true);
  313.  
  314.     mDlog1 := DemoDialog('Modeless Dialog 1', 50, 50);
  315.     mDlog2 := DemoDialog('Modeless Dialog 2', 150, 200);
  316.     SetWRefCon(WindowPtr(mDlog1), longint(mDlog2));
  317.     SetWRefCon(WindowPtr(mDlog2), longint(mDlog1));
  318.     SetDText(mDlog1, edit1, 'Modeless Dialog 2');
  319.     SetDText(mDlog2, edit1, 'Modeless Dialog 1');
  320.     SetDProc(mDlog1, user1, @DrawIcon);
  321.     SetDProc(mDlog2, user1, @DrawIcon);
  322.     SetDCtl(mDlog1, radio1, true);
  323.     SetDCtl(mDlog2, radio1, true);
  324.     SetDCtl(mDlog1, check1, true);
  325.     SetDCtl(mDlog2, check1, true);
  326.     SetDCtl(mDlog1, check2, true);
  327.     SetDCtl(mDlog2, check2, true);
  328.     ShowWindow(mDlog1);
  329.     ShowWindow(mDlog2);
  330.  
  331.     SkelMain;
  332.     SkelClobber;
  333. end.